home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 3 / Cream of the Crop 3.iso / utility / 4hist102.zip / 4HIST.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-21  |  6KB  |  214 lines
  1. program delete_duplicate_4dos_command_history_entries;
  2. {------------------------------------------------------------------------------
  3.  
  4.                                 REVISION HISTORY
  5.  
  6. v1.00  : 1993/09/08.  First public release.  DDA
  7. v1.01  : 1993/10/12.  Fixed bug: would not properly process files in
  8.                             directories other than the current one.  DDA
  9. v1.02  : 1993/10/21.  Enhanced handling of non-current directories.  DDA
  10.  
  11. ------------------------------------------------------------------------------}
  12.  
  13. uses dos , crt ;
  14. type
  15.     link = ^node;
  16.     node = record
  17.              cmd  : string ;
  18.              next : link ;
  19.            end;
  20. var
  21.    inbufr,
  22.    inlist,
  23.    ccmd      : string ;
  24.  
  25.    anchor,
  26.    chain,
  27.    temp,
  28.    cnode     : link ;
  29.  
  30.    before,
  31.    after     : text ;
  32.  
  33.    workpath,
  34.    infile,
  35.    outfile,
  36.    tmpfile   : string ;
  37.  
  38.    i_case,
  39.    twirl     : boolean ;
  40.    histnumb  : word ;
  41.    histsize,
  42.    fdt       : longint ;
  43.  
  44. procedure showhelp ( errornum : byte );
  45. const
  46.     progdata = '4HIST- Free 4DOS utility: command history duplicate entry deleter.';
  47.     progdat2 = 'V1.02: October 21, 1993. (c) 1993 by David Daniel Anderson - Reign Ware.';
  48.     usage = 'Usage: 4HIST file [/i (ignore case)]';
  49. var
  50.     message : string [80];
  51. begin
  52.     writeln ( progdata );
  53.     writeln ( progdat2 );
  54.     writeln ;
  55.     writeln ( usage );
  56.     writeln ;
  57.  
  58.     case errornum of
  59.       1 : message := 'you must specify -exactly- one filespec.';
  60.       2 : message := 'cannot find ' + paramstr (1) + '!';
  61.       3 : message := 'unable to open ' + paramstr (1) + '!';
  62.       4 : message := 'file is empty, cannot continue.';
  63.     end;
  64.     writeln ( 'ERROR: (#',errornum,') - ', message );
  65.     halt ( errornum );
  66. end;
  67.  
  68. function converttoupper(w : string) : string;
  69. var
  70.    cp  : integer;        {the position of the character to change.}
  71. begin
  72.      for cp := 1 to length(w) do
  73.          w[cp] := upcase(w[cp]);
  74.      converttoupper := w;
  75. end;
  76.  
  77. procedure openfiles(var sfile, dfile : text; name1, name2, wp : string);
  78. var
  79.      dirinfo : searchrec ;
  80.      inname  : string [64] ;
  81.      insize  : longint ;
  82.  
  83. begin       { open the file to process, and another for output }
  84.      findfirst ( (wp+name1), archive, dirinfo );
  85.      if doserror <> 0 then
  86.         showhelp (2);
  87.  
  88.      inname := wp+dirinfo.name ;
  89.      insize := dirinfo.size ;
  90.  
  91.      assign ( sfile, inname );     { we know names of both, }
  92. {$i-} reset ( sfile ); {$i+}     { but if source does not exist, }
  93.      if ( ioresult <> 0 ) then  { show help                     }
  94.          showhelp(3);
  95.  
  96.      if insize = 0 then
  97.          showhelp(4);
  98.  
  99.      assign ( dfile,wp+name2 );     { create output file regardless }
  100.      rewrite ( dfile );
  101. end;
  102.  
  103. procedure getpath ( var wpath, inf : string );
  104. var
  105.     ps1     : pathstr ;
  106.     rdir    : dirstr ;
  107.     rname   : namestr ;
  108.     rext    : extstr ;
  109. begin
  110.      ps1 := inf;
  111.      ps1 := ( fexpand ( ps1 ));
  112.      fsplit ( ps1,rdir,rname,rext );
  113.      wpath := rdir;
  114.      inf := rname+rext;
  115. end;
  116.  
  117. begin
  118.      outfile := 'dda_4h-!.out';
  119.      tmpfile := 'dda_4h-!.tmp';
  120.      if paramcount >= 1 then
  121.         infile := paramstr (1)
  122.      else showhelp (1) ;
  123.  
  124.      getpath ( workpath, infile );
  125.  
  126.      i_case := false ;
  127.      if ( paramcount = 2 ) then
  128.         if (( converttoupper ( paramstr (2) )) = '/I' )  then
  129.            i_case := true ;
  130.  
  131.      openfiles ( before, after, infile, outfile, workpath );
  132.  
  133.      new ( anchor );
  134.      anchor^.cmd  := '';
  135.      anchor^.next := nil ;
  136.      chain := anchor ;
  137.  
  138.      twirl := true ;
  139.      histsize := 0 ;
  140.      histnumb := 0 ;
  141.  
  142.      while not eof ( before ) do begin
  143.            readln ( before, ccmd );
  144.  
  145.            twirl := not twirl ;
  146.            if twirl then write ('\')
  147.                    else write ('/');
  148.            gotoxy ( wherex - 1, wherey );
  149.  
  150.            histsize := histsize + length ( ccmd ) ;
  151.            histnumb := histnumb + 1 ;
  152.  
  153.            new ( cnode );
  154.            cnode^.cmd  := ccmd ;
  155.            cnode^.next := nil  ;
  156.            chain := anchor ;
  157.  
  158.            inbufr := cnode^.cmd ;
  159.            if i_case then inbufr := converttoupper ( inbufr );
  160.  
  161.            while ( chain^.next <> nil )  do begin
  162.  
  163.                  inlist := chain^.next^.cmd ;
  164.                  if i_case then inlist := converttoupper ( inlist );
  165.  
  166.                  if ( inbufr = inlist ) then
  167.                  begin
  168.                       temp := chain^.next ;
  169.                       chain^.next := chain^.next^.next ;
  170.                       dispose ( temp );
  171.                  end
  172.                  else
  173.                     chain := chain^.next ;
  174.            end;
  175.  
  176.            inlist := chain^.cmd ;
  177.            if i_case then inlist := converttoupper ( inlist );
  178.  
  179.            if ( inbufr <> inlist ) then
  180.            begin
  181.               chain^.next := cnode ;
  182.               chain := cnode ;
  183.            end;
  184.      end;
  185.  
  186.      histsize := histsize + histnumb ;
  187.      write ( 'History was: ', histsize, ' bytes (',
  188.               histnumb, ' commands), and is now: ' );
  189.      histsize := 0 ;
  190.      histnumb := 0 ;
  191.      repeat
  192.            temp := anchor ;
  193.            anchor := anchor^.next;
  194.            dispose ( temp );
  195.            writeln ( after, anchor^.cmd ) ;
  196.            histsize := histsize + length ( anchor^.cmd ) ;
  197.            histnumb := histnumb + 1 ;
  198.      until anchor^.next = nil ;
  199.      dispose ( anchor );
  200.  
  201.      histsize := histsize + histnumb ;
  202.      writeln ( histsize, ' bytes (', histnumb, ' commands).' );
  203.  
  204.      close ( after );
  205.      reset ( after );
  206.      getftime ( before, fdt );
  207.      setftime ( after, fdt );
  208.      close ( before );
  209.      close ( after );
  210.      rename ( before, workpath+tmpfile );
  211.      rename ( after, workpath+infile );
  212.      erase  ( before );
  213. end.
  214.